home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
Menus
/
codeWarriorMenu.tcl
next >
Wrap
Text File
|
1996-09-04
|
12KB
|
452 lines
#=== nowrap =====================================================================
#
# CodeWarrior Interaction
#
# Metrowerks currently has an incomplete appleevent interface.
# Apple events can be used to direct CodeWarrior to compile
# or add individual files, make the project, etc. However,
# there is currently no provision to report specific errors
# back to the controller.
#
#================================================================================
if {$startingUp} {
set cwdebugMenu "•274"
set cwarriorMenu "•268"
addMenu cwarriorMenu
return
}
proc cwarriorMenu {} {}
# called after files saved
lappend savePostHooks codeWarrior_modified
menu -n "$cwarriorMenu" -p codeWarriorProc {
"help"
"/-<UswitchTo"
{menu -n werksFlags -p werksProc {
"debugger"
"switchWhenCompiling"
}}
"createFileset"
{menu -n headers -p cIncludeProc {
"open"
"addFolder…"
"removeFolder…"
"(-"
}}
"(-"
"addFile"
"/K<Ucompile"
"compileFiles"
"checkSyntax"
"precompile…"
"(-"
"openHeader"
"(-"
"/U<Uupdate"
"/M<Umake"
"(-"
"/D<UgotoDebugger"
"/B<UsetBreakpoint"
"clearBreakpoint"
"/J<UshowSource"
"(-"
"/N<UnextError"
"/R<Urun"
}
if {![info exists cwdebugger]} {set cwdebugger 0}
if {![info exists cwswitchWhenCompiling]} {set cwswitchWhenCompiling 1}
markMenuItem werksFlags debugger $cwdebugger
markMenuItem werksFlags switchWhenCompiling $cwswitchWhenCompiling
proc cwhelp {} {
global HOME
edit -r "$HOME:Help:CodeWarrior"
}
proc werksProc {menu item} {
global cw$item modifiedVars
set cw$item [expr -1 * ([set cw$item] - 1)]
markMenuItem werksFlags $item [set cw$item]
lappend modifiedVars cw$item
}
set CWCLASS MMPR
set CDCLASS MWDB
proc cwnextError {} {
nextMatch "*Compiler Errors*"
}
proc dispErr {{win "* Compiler Errors *"}} {
if {[string length $win]} {
set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
if {[regexp {(Line.*)∞} $text dummy sub]} {
message "$sub"
}
}
}
proc codeWarriorProc {menu item} {
cw$item
}
proc cwswitchTo {} {
global CODEWarrior
checkCw
switchTo $CODEWarrior
}
proc cwmake {} {killCwErrors; cwDo Make}
proc cwupdate {} {cwDo UpdP}
proc cwDo {param} {
global CODEWarrior CWCLASS ALPHA
checkCw
switchTo $CODEWarrior
if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(«01»)"]]]} {
warriorErrors $res
}
}
proc cwrun {} {
global CODEWarrior CWCLASS ALPHA cwdebugger
checkCw
killCwErrors
set bug $cwdebugger
switchTo $CODEWarrior
if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(«01»)" DeBg $bug]]]} {
warriorErrors $res
}
}
proc cwprecompile {} {
global CODEWarrior CWCLASS res
checkCw
set fname [car [winNames -f]]
set targ [putfile "Precompile target:"]
switchTo $CODEWarrior
if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(«01»)" Targ [makeAlis $targ]]]] > 40} {
warriorErrors $res
} else {
if {[regexp {errn:([-0-9]+)} $res dummy errno]} {
message "Error number: $errno"
}
}
}
proc cwaddFile {} {
global CODEWarrior CWCLASS
checkCw
switchTo $CODEWarrior
set fname [car [winNames -f]]
set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
}
proc cwcheckSyntax {} {
global CODEWarrior CWCLASS res
checkCw
# switchTo $CODEWarrior
set fname [car [winNames -f]]
if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}] "Errs" "bool(«01»)"]]] > 40} {
warriorErrors $res
}
}
proc killCwErrors {} {
set wins [winNames]
if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
set name [lindex $wins $res]
bringToFront $name
killWindow
}
}
proc cwcompile {} {
global CODEWarrior CWCLASS res ALPHA cwswitchWhenCompiling
save
checkCw
set fname [car [winNames -f]]
killCwErrors
if {$cwswitchWhenCompiling} {
switchTo $CODEWarrior
}
if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(«01»)"]]] > 40} {
warriorErrors $res
}
switchTo $ALPHA
}
proc cwcompileFiles {} {
global CODEWarrior CWCLASS res ALPHA winModes
saveAll
checkCw
set files {}
set wins [winNames -f]
set md $winModes([lindex $wins 0])
foreach w $wins {
if {$md == $winModes($w)} {
lappend files $w
}
}
killCwErrors
switchTo $CODEWarrior
if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [eval makeAlises $files] "Errs" "bool(«01»)"]]] > 40} {
warriorErrors $res
}
switchTo $ALPHA
}
proc cwGetFiles {} {
global CODEWarrior CWCLASS
checkCw
set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
regexp {\[(.*)\]} $res dummy segs
regsub -all {, Seg} $segs {•} segs
set ind 1
foreach seg [split $segs {•}] {
regexp {NumF:([0-9]+)} $seg dummy num
while {$num > 0} {
set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
if {[regexp {FTxt} $res]} {
regexp {«(.*)»} $res dummy spec
set f [specToPathName $spec]
message $f
lappend files $f
}
incr num -1
}
incr ind
}
return $files
}
proc cwcreateFileset {} {
createWarriorFileset
rebuildAllFilesets
}
proc createWarriorFileset {} {
global gfileSets gfileSetsType
set name [prompt "Fileset name? " "CodeWarrior"]
set gfileSets($name) [lsort -command sortByTail [cwGetFiles]]
set gfileSetsType($name) codewarrior
addArrDef gfileSetsType $name codewarrior
if {[askyesno "Save project fileset?"] == "yes"} {
addArrDef gfileSets $name $gfileSets($name)
}
return $name
}
# the error reply from CodeWarrior looks like this
# [ErrM{ErrT:ErCW, ErrS:“function declaration hides inherited virtual function”, file:fss («FFFB000014371443536D617274537464506F7075704D656E752E6800000000000000000000000000000000000000000000000000000000000000000000000000000000000000»), ErrL:64}, ...]
#
# ErrT is the error type parameter
# ErCW indicates a warning
# ErCE indicates an error
# Improvements by jdunning@cs.Princeton.EDU (John Dunning)
proc warriorErrors {res} {
global winModes tileLeft tileTop tileWidth errorHeight
if {[regexp {\[.*\]} $res res]} {
# trim off the outside brackets
set res [string trim $res {[]}]
# replace all the returns in the error list with spaces. this is
# necessary because CW 7.0 can return multi-line error messages,
# which aren't processed correctly by this function.
regsub -all "\r" $res " " res
# delete the first ErrM, and replace the remaining ones (and the preceeding commas)
# with returns
regsub {ErrM} $res "" res
regsub -all {, ErrM} $res "\r" res
set text ""
set errors 0
set warnings 0
set messages 0
set link 0
# split the string into separate lines, one error per line. only process
# process the first 101 errors
foreach err [lrange [split $res "\r"] 0 100] {
# the last two letters in ErrT:Er.. signal whether it's a compile (C) or link (L)
# error and whether it's an error (E) or a warning (W). stick the rest of
# the error message back into err.
if {[regexp {ErrT:Er(.)(.),[ \t]*(.*)} $err unused compileOrLink errorOrWarning err]} {
if {$errorOrWarning == "E"} {
# mark actual errors with a bullet
append text " • "
incr errors
} else {
# mark warnings with a delta
append text " Δ "
incr warnings
}
if {$compileOrLink == "C"} {
# we have a compile error, so strip out the error message, the filespec
# and the line number
if {[regexp {ErrS:“(.*)”.*«(.*)».*ErrL:([0-9]+)} $err unused errorString fileSpec lineNumber]} {
# conver the filespec that was returned in the apple event into a pathname
# so we can display it
set pathName [specToPathName $fileSpec]
# append the file name (the tail of the pathname), the line number,
# the error string, lots of tabs, and then the full pathname
append text "\"[file tail $pathName]\"\t; Line $lineNumber: $errorString\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$pathName\r"
}
} else {
# we got a link error
set link 1
# just strip out the error message. the file the error occurs in doesn't
# seem to get included in the event
if {[regexp {ErrS:“(.*)”} $err unused errorString]} {
# append the error message
append text "$errorString\r"
}
}
} elseif {[regexp {“([^:]*): (.*)”} $err unused fileName message]} {
# we got some sort of message, so strip out the associated file name and
# the message. I'm not sure if CodeWarrior still returns anything of this form.
append text "\"$fileName\" ; $message\r"
incr messages
}
}
set wins [winNames]
if {$errors == 0 && $warnings == 0 && $messages == 0} {
global killCompilerErrors
set killCompilerErrors 1
return
}
new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight
changeMode [set winModes([lindex [winNames] 0]) Brws]
if {$link} {
insertText "(Link: $errors errors, $warnings warnings, $messages messages)\r-----\r$text"
} else {
insertText "($errors errors, $warnings warnings, $messages messages: <cr> to go to line)\r-----\r$text"
}
display 0
goto 0
downBrowse
setWinInfo dirty 0
setWinInfo read-only 1
gotoMatch
}
}
proc codeWarrior_modified fname {
global CWCompSig CWCLASS mode
if {($mode == "C") || ($mode == "C++")} {
foreach p [processes] {
if {[lindex $p 1] == $CWCompSig} {
set res [AEBuild -t 500000 [lindex $p 0] $CWCLASS "Toch" "----" [makeAlis $fname]]
return
}
}
}
}
proc cwTouch {} {
global CODEWarrior CWCLASS
checkCw
switchTo $CODEWarrior
set fname [car [winNames -f]]
set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
}
proc checkCw {} {
global CODEWarrior modifiedVars CWCompSig
if {![info exists CWCompSig]} {set CWCompSig CWIE}
if {[catch {launchBackApplSigs {CWIE MMCC MPCC} CWCompSig} name]} {
getApplSig "Please locate CodeWarrior compiler" CWCompSig
}
set CODEWarrior [file tail [launchBackAppl $CWCompSig]]
}
proc checkCwDebug {} {
global CODEDEBUGGER CWDbgSig modifiedVars
if {[catch {launchBackApplSigs {MPDB MWDB} CWDbgSig} name]} {
getApplSig "Please locate CodeWarrior debugger" CWDbgSig
}
set CODEDEBUGGER [file tail [launchBackAppl $CWDbgSig]]
}
proc cwgotoDebugger {} {
global CODEDEBUGGER
checkCwDebug
switchTo $CODEDEBUGGER
}
proc cwsetBreakpoint {} {
global CODEDEBUGGER CDCLASS res
checkCwDebug
switchTo $CODEDEBUGGER
set fname [car [winNames -f]]
set ln [lindex [posToRowCol [getPos]] 0]
set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
}
proc cwclearBreakpoint {} {
global CODEDEBUGGER CDCLASS res
checkCwDebug
switchTo $CODEDEBUGGER
set fname [car [winNames -f]]
set ln [lindex [posToRowCol [getPos]] 0]
set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
}
proc cwshowSource {} {
global CODEDEBUGGER CDCLASS res
checkCwDebug
switchTo $CODEDEBUGGER
set fname [car [winNames -f]]
set ln [lindex [posToRowCol [getPos]] 0]
set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
}
# "Soff" "long([getPos]" "Eoff" "long([selEnd])"
proc cwopenHeader {} {
if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
return [cIncludeFile $inc]
}
message "No include file found on this line!"
beep
}